home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 May / Macworld (1998-05).dmg / Serious Demos / TeamWave 3.0 / TeamWave Workplace / TeamWave Workplace.rsrc / TEXT_1_tk.txt < prev    next >
Encoding:
Text File  |  1998-02-13  |  5.3 KB  |  190 lines
  1. # tk.tcl --
  2. #
  3. # Initialization script normally executed in the interpreter for each
  4. # Tk-based application.  Arranges class bindings for widgets.
  5. #
  6. # SCCS: @(#) tk.tcl 1.98 97/10/28 15:21:04
  7. #
  8. # Copyright (c) 1992-1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13.  
  14. # Insist on running with compatible versions of Tcl and Tk.
  15.  
  16. package require -exact Tk 8.0
  17. package require -exact Tcl 8.0
  18.  
  19. # Add Tk's directory to the end of the auto-load search path, if it
  20. # isn't already on the path:
  21.  
  22. if {[info exists auto_path]} {
  23.     if {[lsearch -exact $auto_path $tk_library] < 0} {
  24.     lappend auto_path $tk_library
  25.     }
  26. }
  27.  
  28. # Turn off strict Motif look and feel as a default.
  29.  
  30. set tk_strictMotif 0
  31.  
  32. # tkScreenChanged --
  33. # This procedure is invoked by the binding mechanism whenever the
  34. # "current" screen is changing.  The procedure does two things.
  35. # First, it uses "upvar" to make global variable "tkPriv" point at an
  36. # array variable that holds state for the current display.  Second,
  37. # it initializes the array if it didn't already exist.
  38. #
  39. # Arguments:
  40. # screen -        The name of the new screen.
  41.  
  42. proc tkScreenChanged screen {
  43.     set x [string last . $screen]
  44.     if {$x > 0} {
  45.     set disp [string range $screen 0 [expr $x - 1]]
  46.     } else {
  47.     set disp $screen
  48.     }
  49.  
  50.     uplevel #0 upvar #0 tkPriv.$disp tkPriv
  51.     global tkPriv
  52.     global tcl_platform
  53.  
  54.     if [info exists tkPriv] {
  55.     set tkPriv(screen) $screen
  56.     return
  57.     }
  58.     set tkPriv(activeMenu) {}
  59.     set tkPriv(activeItem) {}
  60.     set tkPriv(afterId) {}
  61.     set tkPriv(buttons) 0
  62.     set tkPriv(buttonWindow) {}
  63.     set tkPriv(dragging) 0
  64.     set tkPriv(focus) {}
  65.     set tkPriv(grab) {}
  66.     set tkPriv(initPos) {}
  67.     set tkPriv(inMenubutton) {}
  68.     set tkPriv(listboxPrev) {}
  69.     set tkPriv(menuBar) {}
  70.     set tkPriv(mouseMoved) 0
  71.     set tkPriv(oldGrab) {}
  72.     set tkPriv(popup) {}
  73.     set tkPriv(postedMb) {}
  74.     set tkPriv(pressX) 0
  75.     set tkPriv(pressY) 0
  76.     set tkPriv(prevPos) 0
  77.     set tkPriv(screen) $screen
  78.     set tkPriv(selectMode) char
  79.     if {[string compare $tcl_platform(platform) "unix"] == 0} {
  80.     set tkPriv(tearoff) 1
  81.     } else {
  82.     set tkPriv(tearoff) 0
  83.     }
  84.     set tkPriv(window) {}
  85. }
  86.  
  87. # Do initial setup for tkPriv, so that it is always bound to something
  88. # (otherwise, if someone references it, it may get set to a non-upvar-ed
  89. # value, which will cause trouble later).
  90.  
  91. tkScreenChanged [winfo screen .]
  92.  
  93. # tkEventMotifBindings --
  94. # This procedure is invoked as a trace whenever tk_strictMotif is
  95. # changed.  It is used to turn on or turn off the motif virtual
  96. # bindings.
  97. #
  98. # Arguments:
  99. # n1 - the name of the variable being changed ("tk_strictMotif").
  100.  
  101. proc tkEventMotifBindings {n1 dummy dummy} {
  102.     upvar $n1 name
  103.     
  104.     if $name {
  105.     set op delete
  106.     } else {
  107.     set op add
  108.     }
  109.  
  110.     event $op <<Cut>> <Control-Key-w>
  111.     event $op <<Copy>> <Meta-Key-w> 
  112.     event $op <<Paste>> <Control-Key-y>
  113. }
  114.  
  115. #----------------------------------------------------------------------
  116. # Define the set of common virtual events.
  117. #----------------------------------------------------------------------
  118.  
  119. switch $tcl_platform(platform) {
  120.     "unix" {
  121.     event add <<Cut>> <Control-Key-x> <Key-F20> 
  122.     event add <<Copy>> <Control-Key-c> <Key-F16>
  123.     event add <<Paste>> <Control-Key-v> <Key-F18>
  124.     trace variable tk_strictMotif w tkEventMotifBindings
  125.     set tk_strictMotif $tk_strictMotif
  126.     }
  127.     "windows" {
  128.     event add <<Cut>> <Control-Key-x> <Shift-Key-Delete>
  129.     event add <<Copy>> <Control-Key-c> <Control-Key-Insert>
  130.     event add <<Paste>> <Control-Key-v> <Shift-Key-Insert>
  131.     }
  132.     "macintosh" {
  133.     event add <<Cut>> <Control-Key-x> <Key-F2> 
  134.     event add <<Copy>> <Control-Key-c> <Key-F3>
  135.     event add <<Paste>> <Control-Key-v> <Key-F4>
  136.     event add <<Clear>> <Clear>
  137.     }
  138. }
  139.  
  140. # ----------------------------------------------------------------------
  141. # Read in files that define all of the class bindings.
  142. # ----------------------------------------------------------------------
  143.  
  144. if {$tcl_platform(platform) != "macintosh"} {
  145.     source $tk_library/button.tcl
  146.     source $tk_library/entry.tcl
  147.     source $tk_library/listbox.tcl
  148.     source $tk_library/menu.tcl
  149.     source $tk_library/scale.tcl
  150.     source $tk_library/scrlbar.tcl
  151.     source $tk_library/text.tcl
  152. }
  153.  
  154. # ----------------------------------------------------------------------
  155. # Default bindings for keyboard traversal.
  156. # ----------------------------------------------------------------------
  157.  
  158. bind all <Tab> {tkTabToWindow [tk_focusNext %W]}
  159. bind all <Shift-Tab> {tkTabToWindow [tk_focusPrev %W]}
  160.  
  161. # tkCancelRepeat --
  162. # This procedure is invoked to cancel an auto-repeat action described
  163. # by tkPriv(afterId).  It's used by several widgets to auto-scroll
  164. # the widget when the mouse is dragged out of the widget with a
  165. # button pressed.
  166. #
  167. # Arguments:
  168. # None.
  169.  
  170. proc tkCancelRepeat {} {
  171.     global tkPriv
  172.     after cancel $tkPriv(afterId)
  173.     set tkPriv(afterId) {}
  174. }
  175.  
  176. # tkTabToWindow --
  177. # This procedure moves the focus to the given widget.  If the widget
  178. # is an entry, it selects the entire contents of the widget.
  179. #
  180. # Arguments:
  181. # w - Window to which focus should be set.
  182.  
  183. proc tkTabToWindow {w} {
  184.     if {"[winfo class $w]" == "Entry"} {
  185.     $w select range 0 end
  186.     $w icur end
  187.     }
  188.     focus $w
  189. }
  190.